home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / MISCPAS.ARJ / PRNDRV.PQS / PRNDRV.PAS
Pascal/Delphi Source File  |  1992-01-02  |  7KB  |  213 lines
  1. {downloaded by Toad Hall from Delaware FIDO, 9 Feb 86.
  2.  author unknown.  Assumed to be public domain release,
  3.  with usual "no commercial use, no sale for profit" constraints.
  4.  PC or clone peculiar right now because of the video memory
  5.  locations in the code and the keyboard interrupt 16H
  6.  (but could be hacked for other setups or displays easily).
  7.  David Kirschbaum
  8.  Toad Hall
  9.  ABN.ISCAMS@USC-ISID.ARPA
  10. }
  11.  
  12.   {
  13.   PRNDRV.PAS
  14.   printer driver to provide clean error handling
  15.   modification of Kim Kokkonen's TUFPRT, to include his later
  16.   changes, some corrections to error handling, & restore of display
  17.   after error message
  18.   }
  19.  
  20. PROGRAM PRNDRV;               { including test program }
  21.  
  22.   TYPE
  23.     Printers = (LPT1, LPT2, LPT3, LPT4, NoPrinter);
  24.   CONST
  25.     ActivePrinter : Printers = NoPrinter;
  26.   VAR
  27.     SavePrintTimeOut : Byte;
  28.     {
  29.     the following bytes normally equal $14, providing 20 retries on printer
  30.     busy calls. Set to 1 for a single retry (timeout takes about 2 seconds).
  31.     Do not set to 0 or system will retry forever.
  32.     }
  33.     PrintTimeOut : ARRAY[Printers] OF Byte ABSOLUTE $40 : $78;
  34.  
  35.   PROCEDURE PrintChar(ch : Char);
  36.       {-print the character ch, handle errors & loop when busy }
  37.       {
  38.       **********************************************************************
  39.       CANNOT USE TURBO I/O FUNCTIONS INSIDE HERE DUE TO RE-ENTRANCY PROBLEMS
  40.       **********************************************************************
  41.       }
  42.  
  43.     TYPE
  44.       PrintErrors =
  45.       (TimeOut, unused1, unused2, IOerror, Selected,
  46.       OutOfPaper, Acknowledge, Busy, NoError);
  47.  
  48.       DisplayString = STRING[80];
  49.  
  50.       registers =
  51.       RECORD
  52.         CASE Integer OF
  53.           1 : (ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer);
  54.           2 : (al, ah, bl, bh, cl, ch, dl, dh : Byte);
  55.       END;
  56.  
  57.     CONST
  58.       PrintErrorMsg : ARRAY[PrintErrors] OF DisplayString =
  59.       ('Printer Timeout Error', '', '', 'Printer Not Selected',
  60.       'Printer Not Selected', 'Printer Out of Paper',
  61.       'Printer Acknowledge Error', 'Printer Busy', '');
  62.  
  63.       EndStr : DisplayString = #13#10#36;
  64.  
  65.       {maximum number of replies with busy before calling it a timeout error.
  66.       may need to be adjusted empirically to avoid false timeouts}
  67.       BusyMax = 100;
  68.  
  69.     VAR
  70.       reg : registers;
  71.       Error : PrintErrors;
  72.       BusyCount : Integer;
  73.     VAR err : Byte;
  74.  
  75.  
  76.     PROCEDURE writestring(s : DisplayString);
  77.         {-write string to standard output}
  78.       VAR
  79.         reg : registers;
  80.       BEGIN
  81.         reg.ah := 9;
  82.         reg.ds := Seg(s);
  83.         reg.dx := Ofs(s[1]);
  84.         MsDos(reg);
  85.       END;                    {displaystring}
  86.  
  87.     PROCEDURE getchar(VAR response : Char);
  88.         {-get a character from the keyboard}
  89.       VAR
  90.         reg : registers;
  91.       BEGIN
  92.         reg.ah := 0;
  93.         Intr($16, reg);
  94.         response := Chr(reg.al);
  95.       END;                    {getchar}
  96.  
  97.  
  98.     PROCEDURE HandleError(Error : PrintErrors);
  99.         {-handle user-oriented error conditions}
  100.       TYPE
  101.         ScreenContents = ARRAY[1..4000] OF Byte;
  102.       VAR
  103.         CrtMode : Byte ABSOLUTE $0040 : $0049;
  104.         MonoBuffer : ScreenContents ABSOLUTE $B000 : $0000;
  105.         ColorBuffer : ScreenContents ABSOLUTE $B800 : $0000;
  106.         savescreen : ScreenContents;
  107.         response : Char;
  108.       BEGIN
  109.         IF CrtMode = 7 THEN
  110.           savescreen := MonoBuffer
  111.         ELSE
  112.           savescreen := ColorBuffer; { save screen contents }
  113.         writestring(PrintErrorMsg[Error]+EndStr);
  114.         writestring('Correct condition and then press <ENTER> '+#36);
  115.         REPEAT getchar(response) UNTIL (response IN [#13, #3]);
  116.         writestring(EndStr);
  117.         IF response = #3 THEN Halt; {Ctrl-C}
  118.         BusyCount := 0;
  119.         IF CrtMode = 7 THEN
  120.           MonoBuffer := savescreen
  121.         ELSE
  122.           ColorBuffer := savescreen; { restore screen contents }
  123.       END;                    {handleerror}
  124.  
  125.     PROCEDURE int17(Printer : Printers; func : Byte;
  126.                     CharToPrint : Byte; VAR err : Byte);
  127.         {-call the printer interrupt and return error information}
  128.         {-func =0 to print, =2 to just check status}
  129.       BEGIN
  130.         INLINE(
  131.           $8B/$56/$0C/        {MOV    DX,[BP+0C] - get printer number}
  132.           $8A/$66/$0A/        {MOV    AH,[BP+0A] - get printer function}
  133.           $8A/$46/$08/        {MOV    AL,[BP+08] - get character to print}
  134.           $CD/$17/            {INT    17}
  135.           $C4/$7E/$04/        {LES    DI,[BP+04] - get address of error}
  136.           $26/$88/$25);       {MOV    ES:[DI],AH - return error if any}
  137.       END;                    {int17}
  138.  
  139.  
  140.     BEGIN                     { PrintChar }
  141.       IF ActivePrinter = NoPrinter THEN BEGIN
  142.         writestring('program error: no printer is selected'+EndStr);
  143.         Exit;
  144.       END;
  145.       reg.dx := Ord(ActivePrinter); {equals 0..3}
  146.       BusyCount := 0;
  147.  
  148.       REPEAT
  149.         {print the character}
  150.         int17(ActivePrinter, 0, Ord(ch), err);
  151.         {check for errors}
  152.         IF (err AND 128) <> 0 THEN BEGIN
  153.           {printer busy}
  154.           BusyCount := Succ(BusyCount);
  155.           IF BusyCount < BusyMax THEN
  156.             Error := Busy
  157.           ELSE BEGIN
  158.             {busy too long, call it a timeout}
  159.             HandleError(TimeOut);
  160.             Error := TimeOut;
  161.           END;
  162.         END ELSE IF (err AND 41) <> 0 THEN BEGIN
  163.           {a "hard" error}
  164.           IF (err AND 32) <> 0 THEN
  165.             HandleError(OutOfPaper)
  166.           ELSE IF (err AND 8) <> 0 THEN
  167.             HandleError(IOerror)
  168.           ELSE HandleError(TimeOut);
  169.           Error := IOerror;
  170.         END ELSE
  171.           Error := NoError;
  172.       UNTIL Error = NoError;
  173.     END;                      {printchar}
  174.  
  175.  
  176.   PROCEDURE ProtectPrinter(Printer : Printers);
  177.       {-define the Lst device to print to the specified printer}
  178.     BEGIN
  179.       IF ActivePrinter = NoPrinter THEN BEGIN
  180.         ActivePrinter := Printer;
  181.         LstOutPtr := Ofs(PrintChar);
  182.         {save current printer timeout}
  183.         SavePrintTimeOut := PrintTimeOut[Printer];
  184.         {set to minimum timeout period}
  185.         PrintTimeOut[Printer] := 1;
  186.       END ELSE
  187.         WriteLn(Con,
  188.         'program error: only one printer can be protected at a time');
  189.     END;                      {protectprinter}
  190.  
  191.   PROCEDURE RestorePrinter;
  192.       {-deassign the Lst device and restore the printer timeout}
  193.     BEGIN
  194.       IF ActivePrinter <> NoPrinter THEN BEGIN
  195.         PrintTimeOut[ActivePrinter] := SavePrintTimeOut;
  196.         ActivePrinter := NoPrinter;
  197.       END;
  198.     END;                      {restoreprinter}
  199.  
  200.     {end of include portion
  201.     ***********************************************************************}
  202.  
  203.     {demonstration follows}
  204.   VAR
  205.     i : Integer;
  206.   BEGIN
  207.     ProtectPrinter(LPT1);
  208.     FOR i := 1 TO 25 DO
  209.       {any writes to the Lst device are now protected}
  210.       WriteLn(Lst, 'hello hello hello hello');
  211.     RestorePrinter;
  212.   END.
  213.